perm filename BMSTF.F4[P11,LCS] blob sn#581882 filedate 1981-04-28 generic text, type T, neo UTF8
	SUBROUTINE BMSTF
      IMPLICIT INTEGER(A-Q,S-Z)                      
      REAL DISX,HGT,POS,CENTR,HGT1                    
      COMMON/STF/RSTFAC(0/7),RSTJ2/MIN/MINI,RMINI /DL/RSIZ
      COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/BM/RA,RC,RJY        
      COMMON/POSI/STFF(0/7),JJ2,POS/PLTR/PLT,RHT,DIS          
      COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,  
     1 RJA,YY,DISX,HGT,RZ,INP(53)                              
      EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)) 
     1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
     1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
     1,(R7,RJQ(5)),(R4,RJQ(2)),(R10,RJQ(8)),(RX3,RJQ(20)),(R11,RJQ(9))
      DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,RBM/.83/ 
C RDBR IS SPACER FOR DBL BAR. TO COMPENSATE FOR NOTE #3 COMING AT POS=0       
	JJ8=0
	IF(J8.GE.0)GO TO 99
	IF(J8.LE.-10)GO TO 99
C  FOR PARTIAL BEAMS
C*** TYPE R8=-1 OR R9=-1 TO PUT R3 INTO R8 OR R6 INTO R9
C  GET MS[NEWNPROCESSED POS. OF R3.   PUT IT IN R8
	R8=RX3
	J8=R8
	IF(J8.EQ.0)J8=1
99	IF(J9.GE.0)GO TO 100
	IF(R7.LT.0)GO TO 100
C TREMOLO POS. IN R9
	IF(J9.GE.0)GO TO 100
	R9=R6
	RR6=R6
100	R3Q=R3
C  NEXT IS FOR BEAMS       
      RMINI=RSTJ2  
	RX=RSTJ2*16.092
	JRVRS=0
	IF(J10.LT.10)GO TO 101
	JRVRS=J10/10
C 1=LENGTHEN LEFT SIDE, 2=RIGHT, 3=BOTH
	J10=J10-JRVRS*10
C VERT DISPLACEMENT MUST BE LESS THAN 10
	R10=J10
101	JJ7=J7
	      R6=RHORZ(R6)
	IF(J8.GE.0)GO TO 88
	IF(R9.NE.0)GO TO 88
CC	IF(R9.NE.0)GO TO 91
	CALL PBEAM
	GO TO 1

CC91	JJ8=-J8
88     IF(J7.LT.0)GO TO 204      
	IF(J10.EQ.0.AND.R9.GT.0)GO TO 1
C   R8=0 AND R9=NUM  -- PUTS NUMBER OUTSIDE BEAM(FOR TRIPLET
204	IF(R9.NE.0)R9=RHORZ(R9)
   	IF(J7.GE.0)GO TO 201
	CALL TREM(RH)
	GO TO 1

C   NEXT FOR INNER, PARTIAL BEAMS    
201	IF(J8.EQ.0)GO TO 1
	IF(J8.GT.0)R8=RHORZ(R8)
C FIND TRUE HORIZONTAL POSITION IN PIXELS
    	JJ10=J10/10         
C  J10/10  =0 OR 1 OR 2        R10 NOW = DISPLACEMENT
	R10=J10-JJ10*10   
	IF(JJ10.NE.0)GO TO 22
	J10=J10+10
	GO TO 4
22	IF(JJ10.EQ.2)GO TO 3
2	RH=R9+RX
	GO TO 1
3       R8=R9-RX     
C  10=SHRT PARTIAL LFT↑RT., 20=RT.↑LFT, 30=TO POS IN P8    
4     RH=R8
C  LEFT INNER POS. 
1     IF(IABS(J4).GE.80)RMINI=.6*RSTJ2       
      RJ=RMINI*11. 
	RW=RMINI*RHGT
C  DIST. UP OR DOWN FROM NOTE HEAD.
	RJA=R10*RJ
C   DISPLACEMENT
	RD=R9
C   POSITION 3
	RJX=CENTR-RW+RJA
C   FINAL HEIGHT OF LEFT SIDE          NEG R7=TREMOLO  

      RX=MOD(J7,10)

      JJ2=J7-20    
      RA=R6
C   HORIZANTAL DIST.
	RJY=(7.*R5-18.)*RSTJ2+RJA+POS-RW
C  VERTICAL POS OF RIGHT SIDE.    
      RW=R14*RMINI 
	RY=1.
	IF(PLT.GE.0)GO TO 197
	IF(RSIZ.GE.2.)RY=2.
	  RY=RY/(RSTJ2*RSIZ)
C USE ONLY EVERY OTHER LINE FOR BEAMS IF SIZ≥2. (VCLIP FILLS IT IN.)
197   IF(J7.LT.20)CALL STEMUP(RY,RH)
C NO CALL IF STEMS ARE DOWN   

98    RSTJ2=RSTJ2*RBM      
C   RBM BRINGS LINES OF BEAMS CLOSER TOGETHER. (=.83)       
	RJJ2=JJ2
	IF(JRVRS.EQ.0)GO TO 219 

	X=RW
C  HORIZ. SIZE OF A NOTE
	IF(J7.LT.20)X=-X
C  CHECK ON STEM DIR. OF BEAM       DISPL=-DISPL IF TO LEFT
	IF(JRVRS.EQ.3)GO TO 19
	IF(JRVRS.NE.1)GO TO 119
C  1 PUSH LEFT, 2 PUSH RIGHT, 3=BOTH
19	R3Q=R3Q+X
	IF(JRVRS.EQ.1)GO TO 219 
C  IF 3, THEN DO NEXT ALSO
	X=-X
119	RA=X
219 	IF(RJJ2.GT.RX)GO TO 94
	IF(J10.GE.10)GO TO 7 
      IF(J8.EQ.0)GO TO 94  
	R3=RW
      IF(J9.EQ.0)GO TO 292 
       IF(J8.GE.20)GO TO 193
293   RX=R3Q-RD    
      GO TO 194    
7     RHX=RH-R3Q   
	R3=RD-R3Q
      GO TO 292    
193   RX=RD-RA     
194   R3=ABS(RX)   
292   DISX=ABS(R3Q-RA)     
      HGT=RJX-RJY  
      IF(J10.GE.10)HGT1=HGT*(RH-R3Q)/DISX       
      R3=R3/DISX   
195   HGT=HGT*R3   
	JJ8=J8
      J8=0 
      IF(J10.GE.10)GO TO 8 
	 L=JJ8/10 
      IF(L.EQ.1)GO TO 95   
C  BEAM LFT=1,  RT=2   (PARAM 8=10 OR 20) 
      R3Q=RD       
      RJX=RJY+HGT  
      GO TO 94     

8     R3Q=RH       
      RJY=RJX-HGT  
      RJX=RJX-HGT1 
	GO TO 295
95	RJY=RJX-HGT  
295	RA=RD
94	IF(PLT.GE.0)GO TO 930 
C SKIP NEXT FOR DPY
      L=7.5*RMINI*RSIZ
C  MAKES CORRECT THICKNESS ON PLOTTER.
	IF(RSIZ.GE.2.0)L=L/2
C HALF AS MANY LINES.

930   RC=0 
C  MINI LINES HAVE .2 SMALLER BEAMS.  MAYBE CHANGE THIS??  
	CALL LINES(R3Q,RJX,3)
	DO 941 K=1,L 
	CALL BMS     
	IF(PLT.GE.0)GO TO 940
	RC=RC+RY     
C  FOR THICKENING.  
	CALL BMS     
	CALL EXCH(RA,R3Q)  
941   CALL EXCH(RJY,RJX)   
	CALL BMS     
940   JJ2=JJ2-1    
      IF(JJ2.LE.0)GO TO 942
C  IF P7=10 OR 20 ONE BEAM WILL APPEAR.    
      RJY=RJY+RJ   
      RJX=RJX+RJ   
	GO TO 930    
942   IF(JJ8.NE.0)RETURN    
      IF(J9.LE.0)RETURN    
      IF(R10.GE.30)RETURN  
	IF(J7.LT.0)RETURN
C  FOR NUMBERS OUTSIDE BEAMS
	RD=-10.      
	IF(R7.LT.20)RD=8.3   
	J3=R3Q+(RA-R3Q)/2.   

      R6=.875* RMINI
C  R6 NOW = 0.875 (SIZE OF NUM.)
	IF(J4.LT.80)GO TO 943
	RD=RD*.7   
	IF(RD)RD=RD-RBM
	R6=0.6
	RSTJ2=RSTJ2/RBM
943 	RSTJ2=RMINI
	R7=1 
C  ITALICS  
      	R4=R4+(R5-R4)/2.+RD  
	R11=0
	CALL MAKNUM(R9)      
	END